fix test suite breakage

640bc43c38e37f0acbc5d83d072af82e4e8cc5fa broke a test. Change that test
to not use encryption=shared. Which required some refactoring.

Sponsored-by: Joshua Antonishen

diff --git a/Test.hs b/Test.hs
index bf09dd7d559ea8894f69335e47dfc1680926451b..62cb88c10fbf52ee6169986b302adb65f46c6188 100644 (file)
--- a/Test.hs
+++ b/Test.hs
@@ -90,7 +90,6 @@ import qualified Utility.MoveFile
 import qualified Utility.StatelessOpenPGP
 import qualified Types.Remote
 #ifndef mingw32_HOST_OS
-import qualified Utility.OsString as OS
 import qualified Remote.Helper.Encryptable
 import qualified Types.Crypto
 import qualified Utility.Gpg
@@ -1917,64 +1916,44 @@ test_gpg_crypto = do
        testscheme "hybrid"
        testscheme "pubkey"
   where
-       gpgcmd = Utility.Gpg.mkGpgCmd Nothing
-       testscheme scheme = Utility.Tmp.Dir.withTmpDir (literalOsPath "gpgtmp") $ \gpgtmp -> do
-               -- Use the system temp directory as gpg temp directory because 
-               -- it needs to be able to store the agent socket there,
-               -- which can be problematic when testing some filesystems.
-               absgpgtmp <- absPath gpgtmp
-               res <- testscheme' scheme absgpgtmp
-               -- gpg may still be running and would prevent
-               -- removeDirectoryRecursive from succeeding, so
-               -- force removal of the temp directory.
-               liftIO $ removeDirectoryForCleanup (fromOsPath gpgtmp)
-               return res
-       testscheme' scheme absgpgtmp = intmpclonerepo $ do
-               -- Since gpg uses a unix socket, which is limited to a
-               -- short path, use whichever is shorter of absolute
-               -- or relative path.
-               relgpgtmp <- relPathCwdToFile absgpgtmp
-               let gpgtmp = if OS.length relgpgtmp < OS.length absgpgtmp
-                       then relgpgtmp 
-                       else absgpgtmp
-               void $ Utility.Gpg.testHarness (fromOsPath gpgtmp) gpgcmd $ \environ -> do
-                       createDirectory (literalOsPath "dir")
-                       let initps =
-                               [ "foo"
-                               , "type=directory"
-                               , "encryption=" ++ scheme
-                               , "directory=dir"
-                               , "highRandomQuality=false"
-                               ] ++ if scheme `elem` ["hybrid","pubkey"]
-                                       then ["keyid=" ++ Utility.Gpg.testKeyId]
-                                       else []
-                       git_annex' "initremote" initps (Just environ) "initremote"
-                       git_annex_shouldfail' "initremote" initps (Just environ) "initremote should not work when run twice in a row"
-                       git_annex' "enableremote" initps (Just environ) "enableremote"
-                       git_annex' "enableremote" initps (Just environ) "enableremote when run twice in a row"
-                       git_annex' "get" [annexedfile] (Just environ) "get of file"
-                       annexed_present annexedfile
-                       git_annex' "copy" [annexedfile, "--to", "foo"] (Just environ) "copy --to encrypted remote"
-                       (c,k) <- annexeval $ do
-                               uuid <- Remote.nameToUUID "foo"
-                               rs <- Logs.Remote.readRemoteLog
-                               Just k <- Annex.WorkTree.lookupKey (toOsPath annexedfile)
-                               return (fromJust $ M.lookup uuid rs, k)
-                       let key = if scheme `elem` ["hybrid","pubkey"]
-                                       then Just $ Utility.Gpg.KeyIds [Utility.Gpg.testKeyId]
-                                       else Nothing
-                       testEncryptedRemote environ scheme key c [k] @? "invalid crypto setup"
+       testscheme scheme = intmpclonerepo $ test_with_gpg $ \gpgcmd environ -> do
+               createDirectory (literalOsPath "dir")
+               let initps =
+                       [ "foo"
+                       , "type=directory"
+                       , "encryption=" ++ scheme
+                       , "directory=dir"
+                       , "highRandomQuality=false"
+                       ] ++ if scheme `elem` ["hybrid","pubkey"]
+                               then ["keyid=" ++ Utility.Gpg.testKeyId]
+                               else []
+               git_annex' "initremote" initps (Just environ) "initremote"
+               git_annex_shouldfail' "initremote" initps (Just environ) "initremote should not work when run twice in a row"
+               git_annex' "enableremote" initps (Just environ) "enableremote"
+               git_annex' "enableremote" initps (Just environ) "enableremote when run twice in a row"
+               git_annex' "get" [annexedfile] (Just environ) "get of file"
+               annexed_present annexedfile
+               git_annex' "copy" [annexedfile, "--to", "foo"] (Just environ) "copy --to encrypted remote"
+               (c,k) <- annexeval $ do
+                       uuid <- Remote.nameToUUID "foo"
+                       rs <- Logs.Remote.readRemoteLog
+                       Just k <- Annex.WorkTree.lookupKey (toOsPath annexedfile)
+                       return (fromJust $ M.lookup uuid rs, k)
+               let key = if scheme `elem` ["hybrid","pubkey"]
+                       then Just $ Utility.Gpg.KeyIds [Utility.Gpg.testKeyId]
+                       else Nothing
+               testEncryptedRemote gpgcmd environ scheme key c [k] @? "invalid crypto setup"
        
-                       annexed_present annexedfile
-                       git_annex' "drop" [annexedfile, "--numcopies=2"] (Just environ) "drop"
-                       annexed_notpresent annexedfile
-                       git_annex' "move" [annexedfile, "--from", "foo"] (Just environ) "move --from encrypted remote"
-                       annexed_present annexedfile
-                       git_annex_shouldfail' "drop" [annexedfile, "--numcopies=2"] (Just environ) "drop should not be allowed with numcopies=2"
-                       annexed_present annexedfile
+               annexed_present annexedfile
+               git_annex' "drop" [annexedfile, "--numcopies=2"] (Just environ) "drop"
+               annexed_notpresent annexedfile
+               git_annex' "move" [annexedfile, "--from", "foo"] (Just environ) "move --from encrypted remote"
+               annexed_present annexedfile
+               git_annex_shouldfail' "drop" [annexedfile, "--numcopies=2"] (Just environ) "drop should not be allowed with numcopies=2"
+               annexed_present annexedfile
        {- Ensure the configuration complies with the encryption scheme, and
         - that all keys are encrypted properly for the given directory remote. -}
-       testEncryptedRemote environ scheme ks c keys = case Remote.Helper.Encryptable.extractCipher pc of
+       testEncryptedRemote gpgcmd environ scheme ks c keys = case Remote.Helper.Encryptable.extractCipher pc of
                Just cip@Crypto.SharedCipher{} | scheme == "shared" && isNothing ks ->
                        checkKeys cip Nothing
                Just cip@(Crypto.EncryptedCipher encipher v ks')
@@ -2210,9 +2189,26 @@ test_enableremote_encryption_changes = intmpclonerepo $ do
                "enableremote disabling encryption"
        git_annex_shouldfail "enableremote" ["bar", "onlyencryptcreds=yes", dirparam]
                "enableremote with onlyencryptcreds"
-       git_annex "initremote" ["baz", "type=directory", "encryption=shared", "onlyencryptcreds=yes", dirparam]
-               "initremote"
-       git_annex_shouldfail "enableremote" ["baz", "onlyencryptcreds=no", dirparam]
-               "enableremote disabling onlyencryptcreds"
-       git_annex "enableremote" ["baz", "onlyencryptcreds=yes", dirparam]
-               "enableremote enabling already enabled onlyencryptcreds"
+       git_annex_shouldfail "initremote" ["baz", "type=directory", "encryption=shared", "onlyencryptcreds=yes", dirparam]
+               "initremote with onlyencryptcreds not allowed with shared encryption"
+       git_annex_shouldfail "initremote" ["baz", "type=directory", "encryption=none", "onlyencryptcreds=yes", dirparam]
+               "initremote with onlyencryptcreds not allowed with no encryption"
+#ifndef mingw32_HOST_OS
+       test_with_gpg $ \_gpgcmd environ -> do
+               git_annex' "initremote"
+                       ["baz"
+                       , "type=directory"
+                       , "encryption=hybrid"
+                       , "onlyencryptcreds=yes"
+                       , "highRandomQuality=false"
+                       , "keyid=" ++ Utility.Gpg.testKeyId
+                       , dirparam]
+                       (Just environ)
+                       "initremote with onlyencryptcreds and hybrid encryption"
+               git_annex_shouldfail' "enableremote" ["baz", "onlyencryptcreds=no", dirparam]
+                       (Just environ)
+                       "enableremote disabling onlyencryptcreds"
+               git_annex' "enableremote" ["baz", "onlyencryptcreds=yes", dirparam]
+                       (Just environ)
+                       "enableremote enabling already enabled onlyencryptcreds"
+#endif

diff --git a/Test/Framework.hs b/Test/Framework.hs
index 09ffe0a26df88941592f5676db128ffd8772ed65..3d0a96fa2f349eb09c1e3e30fb5f7ee0ca36a258 100644 (file)
--- a/Test/Framework.hs
+++ b/Test/Framework.hs
@@ -1,11 +1,11 @@
 {- git-annex test suite framework
  -
- - Copyright 2010-2023 Joey Hess <id@joeyh.name>
+ - Copyright 2010-2024 Joey Hess <id@joeyh.name>
  -
  - Licensed under the GNU AGPL version 3 or higher.
  -}
 
-{-# LANGUAGE OverloadedStrings #-}
+{-# LANGUAGE OverloadedStrings, CPP #-}
 
 module Test.Framework where
 
@@ -67,6 +67,9 @@ import qualified Utility.Metered
 import qualified Utility.HumanTime
 import qualified Command.Uninit
 import qualified Utility.OsString as OS
+#ifndef mingw32_HOST_OS
+import qualified Utility.Gpg
+#endif
 
 -- Run a process. The output and stderr is captured, and is only
 -- displayed if the process does not return the expected value.
@@ -517,6 +520,33 @@ add_annex f faildesc = ifM (unlockedFiles <$> getTestMode)
        , git_annex "add" [f] faildesc
        )
 
+#ifndef mingw32_HOST_OS
+test_with_gpg :: (Utility.Gpg.GpgCmd -> [(String, String)] -> Assertion) -> Assertion
+test_with_gpg a = Utility.Tmp.Dir.withTmpDir (literalOsPath "gpgtmp") $ \gpgtmp -> do
+       -- Use the system temp directory as gpg temp directory because 
+       -- it needs to be able to store the agent socket there,
+       -- which can be problematic when testing some filesystems.
+       absgpgtmp <- absPath gpgtmp
+       res <- go absgpgtmp
+       -- gpg may still be running and would prevent
+       -- removeDirectoryRecursive from succeeding, so
+       -- force removal of the temp directory.
+       liftIO $ removeDirectoryForCleanup (fromOsPath gpgtmp)
+       return res
+  where
+       gpgcmd = Utility.Gpg.mkGpgCmd Nothing
+       go absgpgtmp = do
+               -- Since gpg uses a unix socket, which is limited to a
+               -- short path, use whichever is shorter of absolute
+               -- or relative path.
+               relgpgtmp <- relPathCwdToFile absgpgtmp
+               let gpgtmp = if OS.length relgpgtmp < OS.length absgpgtmp
+                       then relgpgtmp 
+                       else absgpgtmp
+               void $ Utility.Gpg.testHarness (fromOsPath gpgtmp) gpgcmd $ \environ ->
+                       a gpgcmd environ
+#endif
+
 data TestMode = TestMode
        { unlockedFiles :: Bool
        , adjustedUnlockedBranch :: Bool

diff --git a/doc/bugs/tests_fail__58___There_is_no_security_benefit_.mdwn b/doc/bugs/tests_fail__58___There_is_no_security_benefit_.mdwn
index 144a476b1c5243d25a682be346d3ba243c6401a2..7044738ae0d7c6bad375730bf3ce6bce644f57c1 100644 (file)
--- a/doc/bugs/tests_fail__58___There_is_no_security_benefit_.mdwn
+++ b/doc/bugs/tests_fail__58___There_is_no_security_benefit_.mdwn
@@ -50,3 +50,4 @@ supported repository versions: 8 9 10
 upgrade supported from repository versions: 0 1 2 3 4 5 6 7 8 9 10
 ```
 
+> [[fixed|done]] --[[Joey]]